COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	UDPLAY   WITH SPACEWAR, OCT. 1970. 
C00008 00003	 BEGIN MAIN BODY OF PROGRAM
C00010 00004	 SUBROUTINE TO SET UP IOWD AND READ AND WRITE.
C00012 00005	 SPACE WAR JOB
C00013 00006	 GETBUF - MAKE AN I/O BUFFER
C00014 00007	 STORAGE:
C00015 ENDMK
C⊗;
	TITLE	UDPLAY ;  WITH SPACEWAR, OCT. 1970. 

;  ROUTINE TO READ THE OUTPUT FROM THE MUSIC
;  PROGRAM AND CALL THE D-A CONVERTER TO PLAY.
;  
;   READS FROM UDP DATA WRITTEN WITH 'CONVRT',  THE FIRST RECORD OF WHICH 
;   CONTAINS THE NUMBER OF WORDS OF DATA IN THE ENTIRE DISK FILE.
;   IF 'BLKS' IS CHANGED, ALSO CHANGE IT IN 'CONVRT'.

↓A   ←   1     ;WORK
B   ←   2     ;WORK
C   ←   4     ;WORK
RET ←   3     ;RETURN ACCUMULATOR
↓P   ←	17    ;A PDL
PLEN←	10    ;SIZE OF PDL

NOWAIT←400	; INHIBIT 'XXX is busy, will you wait?`

EXTERNAL JOBFF,JOBREL,JOBSA,JOBSYM

;** CHANGE NEXT TO 14 FOR 'UDPBIG' (TO PLAY AT HIGH SRATES-DOUBLES CORE)
;SEE IF 20 RATHER THAN 7 KEEPS US GOIN'
;BLKS ← =18
BLKS ← =20

;**** 1312 IS FOR 2314 DSK.  CHANGE NUMBER IF NEEDED FOR 3330 DSK. *****
BUFSIZ ←=2336*BLKS

↓DSKCHN ←1             ;DISK CHANNEL FOR INPUT
↓ADCHN  ←2             ;D-A CHANNEL FOR OUTPUT

	OPDEF	READCH	[51B8]
        OPDEF   MESSAGE	[51B8!3B12]
	OPDEF 	LOCK	[CALLI 400076]
	OPDEF 	UNLOCK	[CALLI 400077]

BEG:	HLRO A,JOBSYM	;SAVE SYMBOLS
	MOVN A,A
	ADD A,JOBSYM
	HRLM A,JOBSA
	HRRZM A,JOBFF
	CALLI 0         ;RESET I/O DEVICES
	MOVE P,[IOWD PLEN,PLIST]
	MESSAGE [ASCIZ/
*** Play from the UDP (with Spacewar) ***
/]
	PUSHJ P,GETUDP	;MAKE SURE WE HAVE UDP BEFORE DOING DIALOGUE

;FIND OUT NUMBER OF CHANNELS AND
;THE SPEED.
NCHNS:	MESSAGE	[ASCIZ/
How many channels? /]
	READCH	A
	CAIE A,175
	CAIN A,177
	JRST BEG
	CAIE A,15
	CAIN A,12
	JRST NCHNS+1
	SUBI	A,"0"+1		;CONVERT TO BINR AND ADD 1
	CAIG A,3
	SKIPGE A
	JRST [	OUTSTR [ASCIZ/
Illegal number of channels/]
		JRST NCHNS]
	DPB	A,[POINT 2,OUTBIT,26]

SETSPD:	MESSAGE [ASCIZ/
What is the speed? /]
	READCH  A
	CAIE A,175
	CAIN A,177
	JRST BEG
	CAIE A,15
	CAIN A,12
	JRST SETSPD+1
	SUBI	A,"0"
	CAIG A,5
	SKIPG A
	JRST [	OUTSTR [ASCIZ/
Illegal speed/]
		JRST SETSPD]
	DPB	A,[POINT 3,OUTBIT,32]
; GET READ TO PLAY

LX:	MESSAGE [ASCIZ/
Type 'P` to play:  /]
	readch a
	CAIE A,175
	CAIN A,177
	JRST BEG
	CAIE A,15
	CAIN A,12
	JRST LX+1
	caie a,"P"
	jrst LX
	PUSHJ P,[
	GETUDP:	INIT DSKCHN,NOWAIT+17  ;MODE
		SIXBIT/UDP/		;DEVICE NAME
		0			;NO BUFFER HEADERS
		SKIPA
		POPJ P,
		OUTSTR [ASCIZ/
UDP is in use or assigned to another job.
/]
		HALT BEG]	;RESTART IF DEVICE IS UNAVAILABLE
		
	ENTER	DSKCHN,[0
		0
		0
		0]
	JRST [	OUTSTR	[ASCIZ/
I'm sorry, but I don't believe that you have the Scratch Pack mounted.
Maybe someone has put a password on it.
/]
		HALT BEG]	;FOR NEW UDP CODE
	MOVEI A,BUFSIZ+1	;GET FIRST BUFFER FOR UDP
	PUSHJ P,GETBUF
	SUBI A,1
	MOVEM A,PBUF1
	MOVEI A,BUFSIZ+1	;GET SECOND BUFFER FOR UDP
	PUSHJ P,GETBUF
	SUBI A,1
	MOVEM A,PBUF2
GETAD:	OPEN	ADCHN,[117 	;MODE
         	'AD    '        ;DEVICE NAME
 		0]              ;NO BUFFER HEADERS

  	JRST	[OUTSTR	[ASCIZ/
D to A is unavailable.
/]
		HALT GETAD]
	;HALT IF D-A IS UNAVAILABLE


	INPUT DSKCHN,[IOWD 22,NWD	;READ IN BLOCK CONTAINING EITHER
	               0 ]		;THE ADDRESS OF THE SCRATCH AREA
 	MOVE NWD			;AND THE WORD COUNT, OR AN INDIC-
	CAME [SIXBIT/BITMAP/]		;ATION THAT THE SOUND STARTS IN
	JUMPN [	MOVEI 1			;BLOCK #1
		MOVEM BLKNUM
		JRST PLA2]
NOTHIN:	JUMPE [	OUTSTR [ASCIZ/NOTHING THERE!!!/]
		CALLI 12]
	SKIPE A,NWD+20
	SKIPN B,NWD+21
	JRST NOTHIN
	MOVEM A,BLKNUM
	MOVEM B,NWD
PLA2:	MOVEI A,10
;	MOVEM A,WT#
 	SETOM A,WT#
	SETZM OUTWC
	OUTSTR[ASCIZ/WAITING TO BE LOCKED IN CORE.../]
	LOCK
	OUTSTR[ASCIZ/OK
/]
	SPCWAR 17,SWJOB
	MOVEI A,1
	SKIPL WT
	JRST[	CALLI A,31
		JRST .-1]
	MESSAGE [ASCIZ/
GO? /]
	READCH A
	CAIE A,175
	CAIN A,177
	JRST BEG
	MOVE A,[SIXBIT/GOT 6!/]
	CALLI A,400002

; BEGIN MAIN BODY OF PROGRAM

	SETZM DATERR
	SETZM RUDONE
	SETZM PDPERR
LOOP:	JSP	RET,SUB		;ROUTINE TO READ AND WRITE
PBUF1:	0	;BUF1-1		;USE BUF1 FOR THE I/O
	JUMPLE	B,OUT1   	;DONE
	
	JSP	RET,SUB		;CALL IT AGAIN
PBUF2:	0	;BUF2-1		;USE BUF2 FOR THE I/O
	JUMPG	B,LOOP		;GO BACK FOR MORE IF B>0
OUT1:	SKIPN RUDONE
	JRST OUT1
OUT:	UNLOCK			;UNLOCK US FROM CORE!
	SPCWAR 0,'SSW'
	MOVE A,[SIXBIT/UDPLAY/]
	CALLI A,400002
	close dskchn,		;END OF PROGRAM.
	releas adchn,
	CALLI 0			;RESET I/O AND FREE BUFFER SPACE
SHRINK:	MOVE A,JOBFF
	CALL A,[SIXBIT/CORE/]
	JRST [	OUTSTR[ASCIZ/
HORRIBLE ERROR! CAN'T SHRINK CORE!!!
/]
	HALT SHRINK]
	SKIPE DATERR
	JRST[	MESSAGE[ASCIZ/
Data transmission error.
/]
		JRST LX]
	SKIPE PDPERR
	JRST[	MESSAGE[ASCIZ/
The PDP-6 is hung, try restarting it.
/]
		CALLI  12]
	SKIPLE NWD
	JRST [ MESSAGE[ASCIZ/
%*#%*!% SYSTEM, CAN'T GET UDP ACCESS FAST ENOUGH OR NOT BEING RUN QUICKLY ENOUGH,
TRY AGAIN, AND IF YOU STILL LOSE, SEE IF YOU CAN GET PEOPLE TO STOP WHILE
YOU TRY A THIRD(?) TIME.
GOOD LUCK!
/]
		JRST LX]
	jrst LX

; SUBROUTINE TO SET UP IOWD AND READ AND WRITE.
;  1(RET) WILL BE THE RETURN
;  0(RET) WILL BE THE ADDRESS OF THE BUFFER TO BE
;         PUT IN THE RIGHT HALF OF THE IOWD.
;  A      WILL BE A WORK REGISTER
;  B      WILL BE TESTED ON THE OUTSIDE.

SUB:	MOVNI	A,BUFSIZ	;PICK UP AND COMPLEMENT BUFSIZ
	ADDB	A,NWD		;A←NWD-BUFSIZ
				;NWD←NWD-BUFSIZ
	MOVE	B,A		;SAVE B TO BE TESTED FOR LAST
				;TIME.
	JUMPLE	A,LAST		;SET UP FOR LAST TIME.
	MOVEI	A,0		

	;THE IOWD LOOKS LIKE:
	;  [-BUFSIZ / BUFI-1]

LAST:	ADDI	A,BUFSIZ
	MOVNS	A		;COMPLEMENT A
	HRL	A,0(RET)	;PICK UP BUFI AND MOVE IT
				;TO THE LEFT SIDE OF A.
	MOVSM	A,INLIST	;SWAP A AND MOVE IT.
	MOVEI C,5*=60		;IF IT DOESN'T RESPOND IN 5 SECONDS, ASSUME PDP-6
				;IS HUNG
FULOOP:	SKIPGE OUTWC
	JRST [	SETZ 0
		CALLI 31	;SLEEP FOR A TICK
		SOJGE C,FULOOP
		SETOM PDPERR
		JRST OUT]
	SKIPE RUDONE
	JRST OUT
	INPUT	DSKCHN,INLIST	;READ A RECORD.
	MOVSM	A,OUTWC		;SAME FOR OUTPUT.
	MOVEI A,BLKS
	ADDM A,BLKNUM
	JRST	1(RET)		;RETURN

; SPACE WAR JOB

	BEGIN SWJOB

↑SWJOB:	SOSL WT
	CALLI 400024
	SKIPL OUTWC
	CALLI 400024
	MOVE 1,OUTWC
	SETZM OUTWC
	SKIPE RUDONE
	CALLI 400024
	CONSZ 40		;CHECK TO SEE IF ON THE PDP-6
	JRST[	SETOM PDPERR
		SETOM RUDONE
		CALLI 400024]
	CONO 4,400
	MOVE 2,OUTBIT
	CONO 424,(2)
	MOVE 2,OUTWC+1
	CONO 204,(2)
L1:	CONSO 204,1000
	JRST L1
	BLKO 204,1
	JRST[	MOVE 1,OUTWC
		SETZM OUTWC
		JUMPL 1,L1
		CONSZ 204,10000
	EHO:	SETOM DATERR
		SETOM RUDONE
		CONO 4,200
		CALLI 400024]
	JRST L1
↑PDPERR: 0
↑DATERR: 0
↑RUDONE: 0
	BEND SWJOB

; GETBUF - MAKE AN I/O BUFFER

	BEGIN ALLOC

↑GETBUF:ADD A,JOBFF	
	PUSH P,A	;SAVE WHAT WILL BE JOBFF
GETBU2:	CALL A,[SIXBIT/CORE/]
	JRST [	OUTSTR [ASCIZ/
Can't get enough core!
/]
		MOVE A,(P)	;RECOVER WHAT SHOULD BW JOBFF
		HALT GETBU2]	;ALLOW THE LOSER TO TRY AGAIN
	POP P,A		;RECOVER WHAT WILL BE JOBFF
	EXCH A,JOBFF
	POPJ P,

	BEND ALLOC

; STORAGE:

NWD:	0			;FOR NUMBER OF WORDS OF INPUT.
	BLOCK 21		;TO GET SCRATCH ADDRESS
CLIST:	IOWD	1,NWD		;FOR THE FIRST RECORD
	0

INLIST:	0			;WILL CONTAIN AN IOWD
BLKNUM:	0

OUTWC:	0			;WILL CONTAIN AN IOWD FOR D-A
	3650			;MAGIC BITS FOR 136.
OUTBIT: 4000			;BITS FOR D-A
	BLOCK  2
PLIST:	BLOCK PLEN

PATCH:	BLOCK 20

end beg